home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / CLINIC / VARARGSU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-02-17  |  2.2 KB  |  90 lines
  1. unit Varargsu;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ErrorGrp: TRadioGroup;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure ErrorGrpClick(Sender: TObject);
  14.   private
  15.     { Private declarations }
  16.   public
  17.     { Public declarations }
  18.   end;
  19.  
  20. var
  21.   Form1: TForm1;
  22.  
  23. implementation
  24.  
  25. {$R *.DFM}
  26.  
  27. function Add(const Values: array of const): Double;
  28. var
  29.   Loop: Byte;
  30. const
  31.   BoolStrs: array[Boolean] of String[5] = ('False', 'True');
  32.  
  33.   procedure Error(const S: String);
  34.   begin
  35.     raise EInvalidOp.Create('Bogus value ' + S);
  36.   end;
  37.  
  38. begin
  39.   Result := 0;
  40.   for Loop := Low(Values) to High(Values) do
  41.     with Values[Loop] do
  42.       case VType of
  43.         vtInteger: Result := Result + VInteger;
  44.         vtBoolean: Error(BoolStrs[VBoolean]);
  45.         vtChar:
  46.           if VChar in ['0'..'9'] then
  47.             Result := Result + Ord(VChar) - Ord('0')
  48.           else
  49.             Error('"' + VChar + '"');
  50.         vtExtended: Result := Result + VExtended^;
  51.         vtString:
  52.           try
  53.             Result := Result + StrToFloat(VString^)
  54.           except
  55.             Error('"' + VString^ + '"')
  56.           end;
  57.         vtPointer: Error(Format('%p', [VPointer]));
  58.         vtPChar: Error(StrPas(VPChar));
  59.         vtObject:
  60.           if (VObject is TComponent) and not (VObject is TForm) then
  61.             Error(TComponent(VObject).Name + ': ' + VObject.ClassName)
  62.           else
  63.             Error(VObject.ClassName);
  64.         vtClass: Error(VClass.ClassName);
  65.       end;
  66. end;
  67.  
  68. procedure TForm1.FormCreate(Sender: TObject);
  69. begin
  70.   MessageDlg(FloatToStr(Add([1, '6.7', 9, 3.6, 9])),
  71.     mtInformation, [mbOk], 0);
  72. end;
  73.  
  74. procedure TForm1.ErrorGrpClick(Sender: TObject);
  75. const
  76.   P: PChar = 'Hello';
  77. begin
  78.   case ErrorGrp.ItemIndex of
  79.     0: Caption := FloatToStr(Add([1, 'rrrr']));
  80.     1: Caption := FloatToStr(Add([1, P]));
  81.     2: Caption := FloatToStr(Add([1, False]));
  82.     3: Caption := FloatToStr(Add([1, Ptr($1234, $5678)]));
  83.     4: Caption := FloatToStr(Add([1, ErrorGrp]));
  84.     5: Caption := FloatToStr(Add([1, TForm1]));
  85.     6: Caption := FloatToStr(Add([1, 'a']));
  86.   end;
  87. end;
  88.  
  89. end.
  90.